home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PBLIB1 / UNITS / OBJHOLD.INC < prev    next >
Text File  |  1994-04-30  |  6KB  |  243 lines

  1.  
  2. {SECTION HOLD_object }
  3. CONSTRUCTOR HOLD_object.init(n : HOLD_NdxType);
  4. var l : longint;
  5.     i : HOLD_NdxType;
  6.      begin
  7.      MaxEntries := n;
  8.      ArrHighVal := 0;
  9.      comment := '';
  10.      STRA_object.init(n);
  11.      l := sizeof(HOLD_NumType) * n;
  12.      if memavail > l then
  13.           begin
  14.           getmem(ArrNum,l);
  15.           for i := 1 to arraymax do ArrNum^[i] := 0;
  16.           end;
  17.      end;
  18.  
  19.  
  20. Procedure HOLD_object.done;
  21. var l : longint;
  22.      begin
  23.      ArrHighVal := 0;
  24.      l := sizeof(HOLD_NumType) * arraymax;
  25.      IF (ArrNum <> NIL) and (l > 0) then
  26.           begin
  27.           FreeMem (ArrNum,l);
  28.           ArrNum := NIL;
  29.           end;
  30.      STRA_object.done;
  31.      end;
  32.  
  33.  
  34.  
  35. Function  HOLD_object.HighNum  : HOLD_NumType;
  36.      begin
  37.      HighNum := ArrHighVal;
  38.      end;
  39.  
  40.  
  41. Function  HOLD_object.findstr(st : string) : HOLD_NdxType;
  42. var i,j  : HOLD_NdxType;
  43.      begin
  44.      j := 0;
  45.      i := STRA_object.find(st);
  46.      if i > 0 then j := i;
  47.      findstr := j;
  48.      end;
  49.  
  50.  
  51. Function  HOLD_object.findnum(Num : HOLD_NumType) : HOLD_NdxType;
  52. var i,j  : HOLD_NdxType;
  53.     alldone : boolean;
  54.      begin
  55.      j := 0;
  56.      alldone := false;
  57.      if Num <= ArrHighVal then
  58.           begin
  59.           i := 0;
  60.           while (i < ArrayUsed) and not alldone do
  61.                begin
  62.                inc(i);
  63.                if ArrNum^[i] = Num then
  64.                     begin
  65.                     j := i;
  66.                     alldone := true;
  67.                     end;
  68.                end;
  69.           end;
  70.      findnum := j;
  71.      end;
  72.  
  73.  
  74. Function  HOLD_object.count : HOLD_NdxType;
  75.      begin
  76.      count := ArrayUsed;
  77.      end;
  78.  
  79.  
  80.  
  81. Function  HOLD_object.fetchNumN (n : HOLD_NdxType) : HOLD_NumType;
  82.      begin
  83.      if (n > 0) and (n <= ArrayUsed) then
  84.           fetchNumN := ArrNum^[n]
  85.      else fetchNumN := 0;
  86.      end;
  87.  
  88.  
  89. Function  HOLD_object.fetchStrN (n : HOLD_NdxType) : string;
  90.      begin
  91.      fetchStrN := STRA_object.fetchstring(n);
  92.      end;
  93.  
  94.  
  95. Function HOLD_object.fetchN(n : HOLD_NdxType;var st :string; var Num :HOLD_NumType):boolean;
  96. var ok : boolean;
  97.      begin
  98.      ok := true;
  99.      if n > arrayused then ok := false;
  100.      Num := fetchNumN(n);
  101.      st := fetchStrN(n);
  102.      fetchN := ok;
  103.      end;
  104.  
  105.  
  106. Function HOLD_object.append(st : string; Num : HOLD_NumType) : boolean;
  107. var OK : boolean;
  108.      begin
  109.      OK := STRA_object.append(st);
  110.      if OK then ArrNum^[ArrayUsed] := Num;
  111.      if Num > ArrHighVal then ArrHighVal := Num;
  112.      append := OK;
  113.      end;
  114.  
  115.  
  116. Function HOLD_object.storeN (n : HOLD_NdxType; st : string; Num : HOLD_NumType): Boolean;
  117. var OK : boolean;
  118.      begin
  119.      OK := STRA_object.storeN(n,st);
  120.      if OK then ArrNum^[n] := Num;
  121.      if Num > ArrHighVal then ArrHighVal := Num;
  122.      storeN := OK;
  123.      end;
  124.  
  125.  
  126. {$R-}
  127.  
  128. Procedure HOLD_object.swap(i,j : HOLD_NdxType);
  129. var sptr  : stringptr;
  130.     Num   : HOLD_NumType;
  131.      begin
  132.      STRA_object.swap(i,j);
  133.      Num   := ArrNum^[i];
  134.      ArrNum^[i] := ArrNum^[j];
  135.      ArrNum^[j] := Num;
  136.      end;
  137.  
  138.  
  139. procedure HOLD_object.sort;    {sorts based on string value }
  140. var Gap,I,J,N  : HOLD_NdxType;
  141.     s1,s2      : stringptr;
  142.      begin
  143.      if arraysorted then exit;
  144.      N   := STRA_object.count;
  145.      Gap := N div 2;
  146.      while (Gap > 0) do
  147.          begin
  148.          I := Gap;
  149.          while (I < N) do
  150.               begin
  151.               J := I - Gap;
  152.               s1 := arrayptr^[J+Gap+1].strptr;
  153.               s2 := arrayptr^[J+1].strptr;
  154.               while (J >= 0) and (s1^ < s2^) do
  155.                    begin
  156.                    HOLD_object.swap(J+1,J+Gap+1);
  157.                    dec(J,Gap);
  158.                    s1 := arrayptr^[J+Gap+1].strptr;
  159.                    s2 := arrayptr^[J+1].strptr;
  160.                    end;
  161.               inc(I);
  162.               end;
  163.          Gap:=Gap div 2;
  164.          end;
  165.      arraysorted := true;
  166.      end;
  167.  
  168. {$R+}
  169.  
  170.  
  171.  
  172.  
  173. Procedure HOLD_object.dumpN(n : HOLD_NdxType);
  174. var i  : HOLD_NdxType;
  175.      begin
  176.      if ArrayUsed < 1 then exit;
  177.      if n > ArrayUsed then n := arrayused;
  178.      writeln('dump   used: ',arrayused,'   max: ',ArrHighVal);
  179.      for i := 1 to n do
  180.           begin
  181.           writeln(i:4,'  str [',arrayptr^[i].fetch,']  num [ ',
  182.                   ArrNum^[i]:5,' ]');
  183.           end;
  184.      end;
  185.  
  186.  
  187. Procedure HOLD_object.dump;
  188. var i  : HOLD_NdxType;
  189.      begin
  190.      dumpN(9999);
  191.      end;
  192.  
  193.  
  194.  
  195. Procedure HOLD_object.save(fname : string);
  196. var i   : HOLD_NdxType;
  197.     ok  : boolean;
  198.     s   : string;
  199.     tx  : TFILE_object;
  200.      begin
  201.      if arrayused < 1 then exit;
  202.      tx.init(fname,true);
  203.      if comment <> '' then
  204.           begin
  205.           s := comment;
  206.           trim(s);
  207.           ok := tx.append('!'+s);
  208.           end;
  209.      for i := 1 to arrayused do
  210.           begin
  211.           s := longintstr(ArrNum^[i],8);
  212.           trim(s);
  213.           ok := tx.append(trimstr(arrayptr^[i].fetch)+','+s);
  214.           end;
  215.      tx.done;
  216.      end;
  217.  
  218.  
  219. Procedure HOLD_object.load(fname : string);
  220. var s,st  : string;
  221.     num   : HOLD_NumType;
  222.     ok    : boolean;
  223.     tx    : TFILE_object;
  224.      begin
  225.      comment := '';
  226.      tx.init(fname,false);
  227.      num  := 0;
  228.      while tx.fetchnext(s) do
  229.           begin
  230.           if (num=0) and (s[1]='!') then
  231.                begin
  232.                delete(s,1,1);
  233.                comment := s;
  234.                end
  235.           else begin
  236.                st  := GetString(s);
  237.                num := strlong(GetString(s));
  238.                ok  := HOLD_object.append(st,num);
  239.                end;
  240.           end;
  241.      tx.done;
  242.      end;
  243.